require 'kscheme/error'
require 'kscheme/patch'

module KScheme
  class Cons
    attr_accessor :car, :cdr
    
    def initialize(car, cdr)
      @car = car
      @cdr = cdr
    end
  end

  class Environment
    def initialize(parent=nil)
      @parent = parent
      @hash = Hash.new
    end

    def set(name, val)
      if @hash.has_key?(name)
        @hash[name] = val
      elsif @parent
        @parent.set(name, val)
      else
        raise RuntimeError, "assigning undefined variable #{name}"
      end
    end

    def define(name, val=nil)
      @hash[name] = val
    end

    def get(name)
      if @hash.has_key?(name)
        @hash[name]
      elsif @parent
        @parent.get(name)
      else
        raise RuntimeError, "undefined variable #{name}"
      end
    end

    alias :[]= :define
    alias :[] :get
  end

  class VM
    def initialize
      setup_primitives
    end

    def define_primitive
      lambda { |env, args|
        yield env, *cons_to_a(args)
      }
    end

    def define_proc
      lambda { |env, args|
        if args
          yield *cons_to_a(args, env)
        else
          yield
        end
      }
    end

    def define_collector(sym, init=0)
      lambda { |env, args|
        cons_to_a(args, env).inject(init, &sym)
      }
    end
    
    def eval(env, code)
      case code
      when ::String, ::Numeric
        code
      when ::Symbol
        env.get(code)
      when Cons
        proc = env.get(code.car)
        args = code.cdr
        proc.call(env, args)
      end
    end

    def top_level_env
      @env
    end

    def repl
      loop do
        begin
          print "rscheme > "
          STDOUT.flush
          exp = read_expression
          puts "\n=> " + eval(@env, exp).inspect
        rescue => err
          puts err
        end
      end
    end

    private

    def setup_primitives
      @env = Environment.new

      @env[:nil] = nil
      @env[:"top-level-environment"] = @env
      @env[:quote] = define_primitive { |env, exp| exp }
      @env[:eq?] = define_proc { |a, b| a == b }
      @env[:atom?] = define_proc { |exp|
        [::String, ::Numeric, ::Symbol].any? { |c| exp.is_a? c }
      }
      @env[:cons] = define_proc { |car, cdr| Cons.new(car, cdr) }
      @env[:car] = define_proc { |cons| cons.car }
      @env[:cdr] = define_proc { |cons| cons.cdr }
      @env[:+] = define_collector(:+)
      @env[:-] = define_collector(:-)
      @env[:*] = define_collector(:*, 1)
      @env[:'/'] = define_collector(:'/', 1)
      @env[:begin] = define_proc { |*seq| seq && seq.last }
      @env[:define] = define_primitive { |env, var, *body|
        if var.is_a? Cons
          env.define(var.car, make_lambda(env, var.cdr, body))
        else
          env.define(var, eval(env, body.first))
        end
      }
      @env[:set!] = define_primitive { |env, var, val|
        env.set(var, eval(env,val))
      }
      @env[:lambda] = define_primitive { |env, args, *body|
        make_lambda(env, args, body)
      }
      @env[:let] = define_primitive { |env, bindings, *body|
        bindings = cons_to_a(bindings)
        let_binding = Environment.new(env)
        bindings.each { |cons|
          let_binding.define(cons.car, eval(env, cons.cdr.car))
        }
        eval_seq(let_binding, body)
      }
      @env[:if] = define_primitive { |env, pred, then_stmt, *stmt|
        eval_if(env, pred, stmt.first, stmt.first)
      }
      @env[:cond] = define_primitive { |env, *conds|
        eval_cond(env, conds)
      }
      @env[:read] = define_proc { read_expression }
      @env[:exit] = define_proc { exit }
      @env[:display] = define_proc { |val|
        print val
        STDOUT.flush
        nil
      }
      @env[:newline] = define_proc { puts "" }
    end

    def make_lambda(lexical_env, args, body)
      lambda { |env, params|
        proc_binding = Environment.new(lexical_env)
        cons_to_a(args).zip(cons_to_a(params, env)).each { |var, val|
          proc_binding.define(var, val)
        }
        eval_seq(proc_binding, body)
      }
    end

    def eval_if(env, pred, then_stmt, else_stmt)
      if eval(env, pred)
        eval(env, then_stmt)
      else
        eval(env, else_stmt)
      end
    end

    def eval_cond(env, conds)
      return nil if conds.empty?
      ret_val = nil

      conds.any? { |cond|
        if cond.car == :else || eval(env, cond.car)
          ret_val = eval_seq(env, cons_to_a(cond.cdr))
          true
        else
          false
        end
      }

      ret_val
    end
    
    def eval_seq(env, seq)
      ret_val = nil
      seq.each { |exp|
        ret_val = eval(env, exp)
      }
      ret_val
    end
    
    def cons_to_a(cons, env=nil)
      unless cons.cdr.nil? or cons.cdr.is_a? Cons
        raise InternalError, "Can't convert a non-list cons to array."
      end

      arr = [env.nil? ? cons.car : eval(env, cons.car)]
      arr += cons_to_a(cons.cdr, env) if cons.cdr

      arr
    end

    def read_expression
      parser = SchemeParser.new
      code = readline
      exp = nil
      
      loop do
        exp = parser.try_parse(code)
        break unless exp.nil?

        code << readline
      end

      exp.value
    end

  end
end
